
'*******************************************************************
' Program: Data Center Visio Rack Tool
' Author: Albert E Edlund
' Date:
'
' Purpose:
'*******************************************************************

Imports System.Net
Imports System.Net.NetworkInformation
Imports System.Globalization
Imports System.Text
Imports System.Text.Encoder
Imports System.Threading

Imports Forms = System.Windows.Forms
Imports Microsoft.Practices.EnterpriseLibrary.ExceptionHandling

'
' use the .net framework version 2.0 network processes
'
Public Class clsV2Ping

    Dim WithEvents myPing As New Ping()


#Region " Constructor "

    Public Sub New()
        props = New PingProperties
    End Sub

#End Region

#Region " Properties and declarations "

    Private Structure PingProperties
        Public status As String
        Public rt_time As Int32

        Public ttl As Integer
        Public fragment As Boolean
        Public timeout As Integer
        Public ReverseLookup As Boolean

        Public repeat As Integer
        Public sendaddress As String
        Public sendtext As String
        Public sendsize As Integer
        Public sndIpAddress As IPAddress

        Public rcvaddress As String
        Public rcvtext As String
        Public rcvsize As Integer
        Public rcvhost As String
    End Structure

    Dim props As PingProperties

    ' the key return parameters for sendsync
    ' return status as an ipstatus value
    Public Property PingStatus() As String
        Get
            Return props.status
        End Get
        Set(ByVal value As String)
            props.status = value
        End Set
    End Property
    ' returned round trip time of ping
    Public Property PingRtTime() As Int32
        Get
            Return props.rt_time
        End Get
        Set(ByVal Value As Int32)
            props.rt_time = Value
        End Set
    End Property

    ' our parameters
    ' time-to-live counter (how many hops to work with
    Public Property PingTTL() As Integer
        Get
            Return props.ttl
        End Get
        Set(ByVal Value As Integer)
            props.ttl = Value
        End Set
    End Property
    ' should we allow them to fragment the data
    Public Property PingFragment() As Boolean
        Get
            Return props.fragment
        End Get
        Set(ByVal value As Boolean)
            props.fragment = value
        End Set
    End Property
    ' how long to wait in milliseconds before calling it broke
    Public Property PingTimeout() As Integer
        Get
            Return props.timeout
        End Get
        Set(ByVal Value As Integer)
            props.timeout = Value
        End Set
    End Property
    ' how many times to loop a ping
    Public Property PingRepeat() As Integer
        Get
            Return props.repeat
        End Get
        Set(ByVal value As Integer)
            props.repeat = value
        End Set
    End Property
    ' do we perform a reverse lookup for the returned ip address
    Public Property PingReverse() As Boolean
        Get
            Return props.ReverseLookup
        End Get
        Set(ByVal value As Boolean)
            props.ReverseLookup = value
        End Set
    End Property

    ' the send information
    ' ip address of target
    Public Property PingSendAddress() As String
        Get
            Return props.sendaddress
        End Get
        Set(ByVal Value As String)
            Dim address As IPAddress = Nothing
            If IPAddress.TryParse(Value, address) Then
                props.sendaddress = Value
            Else
                MsgBox("ipaddress is invalid")
            End If
        End Set
    End Property
    ' our send text
    Public Property PingSendText() As String
        Get
            Return props.sendtext
        End Get
        Set(ByVal Value As String)
            props.sendtext = Value
            props.sendsize = CShort(Len(Value))
        End Set
    End Property
    ' the size of the send data
    Public Property PingSendSize() As Integer
        Get
            Return props.sendsize
        End Get
        Set(ByVal Value As Integer)
            props.sendsize = Value
        End Set
    End Property
    ' the real ip address
    Public Property pingIpAddress() As IPAddress
        Get
            Return props.sndIpAddress
        End Get
        Set(ByVal value As IPAddress)
            props.sndIpAddress = value
        End Set
    End Property


    ' the receive information
    ' the ip address returned from the ping
    Public Property PingRcvAddress() As String
        Get
            If props.rcvaddress <> Nothing Then
                Return props.rcvaddress
            Else
                Return ""
            End If
        End Get
        Set(ByVal value As String)
            props.rcvaddress = value
        End Set
    End Property
    ' the text returned from the ping
    Public Property PingRcvText() As String
        Get
            If props.rcvtext <> "" Then
                Return props.rcvtext
            Else
                Return ""
            End If
        End Get
        Set(ByVal Value As String)
            props.rcvtext = Value
        End Set
    End Property
    ' the size of the returned data
    Public Property PingRcvSize() As Integer
        Get
            If props.rcvsize <> Nothing Then
                Return props.rcvsize
            Else
                Return -1
            End If
        End Get
        Set(ByVal Value As Integer)
            props.rcvsize = Value
        End Set
    End Property
    ' the host name of the received address
    Public Property PingRcvHost() As String
        Get
            If props.rcvhost <> "" Then
                Return props.rcvhost
            Else
                Return ""
            End If
        End Get
        Set(ByVal value As String)
            props.rcvhost = value
        End Set
    End Property

#End Region

#Region " Timer Routines "

    Friend Class StatusChecker

        Dim invokeCount, maxCount As Integer

        Sub New(ByVal count As Integer)
            invokeCount = 0
            maxCount = count
        End Sub

        ' This method is called by the timer delegate.
        Sub CheckStatus(ByVal stateInfo As Object)
            Dim autoEvent As Threading.AutoResetEvent = _
                DirectCast(stateInfo, Threading.AutoResetEvent)
            invokeCount += 1
            Console.WriteLine("{0} Checking status {1,2}.", _
                DateTime.Now.ToString("h:mm:ss.fff"), _
                invokeCount.ToString())

            If invokeCount = maxCount Then
                ' Reset the counter and signal to stop the timer.
                invokeCount = 0
                autoEvent.Set()
            End If
        End Sub
    End Class

    ' when pinging / investigating a network care must be
    ' taken not to overload it with traffic. as an
    ' additional note some security mechanisms may decide
    ' that excessive pings is part of a denial-of-service attack.

    Public Sub PingDelay_timer()

        Dim autoEvent As New Threading.AutoResetEvent(False)
        Dim statusChecker As New StatusChecker(10)
        Try

            ' Create the delegate that invokes methods for the timer.
            Dim timerDelegate As Threading.TimerCallback = _
                AddressOf statusChecker.CheckStatus

            ' Create a timer that signals the delegate to invoke 
            ' CheckStatus after one second, and every 1/4 second 
            ' thereafter.
            Console.WriteLine("{0} Creating timer." & vbCrLf, _
                DateTime.Now.ToString("h:mm:ss.fff"))

            Dim stateTimer As Threading.Timer = _
                    New Threading.Timer(timerDelegate, autoEvent, 1000, 250)

            ' When autoEvent signals, change the period to every 
            ' 1/2 second.
            autoEvent.WaitOne(5000, False)
            stateTimer.Change(0, 500)
            Console.WriteLine(vbCrLf & "Changing period." & vbCrLf)

            ' When autoEvent signals the second time, dispose of 
            ' the timer.
            autoEvent.WaitOne(5000, False)
            stateTimer.Dispose()
            Console.WriteLine(vbCrLf & "Destroying timer.")

        Catch err As Exception
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(err, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        End Try

    End Sub



#End Region

#Region " Ping Send Async "


    ' microsoft demo code
    Public Sub testSendAsync()
        props.sendaddress = "127.0.0.1"
        props.ttl = 16
        props.fragment = True
        props.sendtext = "abc"
        props.timeout = 100
        SendAsync()
    End Sub

    '
    ' pass in an ipstatus, rturn a string
    '
    Private Function GetStatusString(ByVal status As IPStatus) As String
        Select Case status
            Case IPStatus.Success
                Return "Success."
            Case IPStatus.DestinationHostUnreachable
                Return "Destination host unreachable."
            Case IPStatus.DestinationNetworkUnreachable
                Return "Destination network unreachable."
            Case IPStatus.DestinationPortUnreachable
                Return "Destination port unreachable."
            Case IPStatus.DestinationProtocolUnreachable
                Return "Destination protocol unreachable."
            Case IPStatus.PacketTooBig
                Return "Packet too big."
            Case IPStatus.TtlExpired
                Return "TTL expired."
            Case IPStatus.ParameterProblem
                Return "Parameter problem."
            Case IPStatus.SourceQuench
                Return "Source quench."
            Case IPStatus.TimedOut
                Return "Timed out."
            Case Else
                Return "Ping Failed"
        End Select
    End Function

    '
    '
    '
    Private Sub SendAsync()

        Dim myOptions As PingOptions

        Dim address As IPAddress = props.sndIpAddress
        Dim timeout As Integer = props.timeout
        Dim buffer As Byte()

        Dim waiter As AutoResetEvent

        waiter = New AutoResetEvent(False)

        Dim intData As Integer = 32

        myOptions = New PingOptions
        myOptions.Ttl = props.ttl
        myOptions.DontFragment = props.fragment

        ' initialize the string
        Dim strData As String = props.sendtext
        ' and put it in the buffer
        buffer = Encoding.ASCII.GetBytes(strData)

        props.status &= _
            "Pinging " & address.ToString & _
            " . . ." & Environment.NewLine

        myPing.SendAsync( _
                address, _
                timeout, _
                buffer, _
                myOptions, _
                waiter _
                )

        waiter.WaitOne()

    End Sub

    '
    '
    '
    Private Sub myPing_PingCompleted( _
                ByVal sender As Object, _
                ByVal e As PingCompletedEventArgs) _
                Handles myPing.PingCompleted

        ' Check to see if an error occurred.  If no error, then display the 
        ' address used and the ping time in milliseconds
        If e.Error Is Nothing Then
            If e.Cancelled Then
                props.status &= _
                    "Ping cancelled." & Environment.NewLine
            Else
                If e.Reply.Status = IPStatus.Success Then
                    props.status &= _
                        "  " & e.Reply.Address.ToString() & " " & _
                        e.Reply.RoundtripTime.ToString( _
                        NumberFormatInfo.CurrentInfo) & "ms " & _
                        Environment.NewLine
                Else
                    props.status &= _
                        "  " & GetStatusString(e.Reply.Status) & _
                        Environment.NewLine
                End If
            End If
        Else
            ' Otherwise display the error
            props.status &= _
                "  Ping error." & Environment.NewLine
            MsgBox( _
                "An error occurred while sending this ping. " & _
                e.Error.InnerException.Message.ToString())
        End If
        ' some completions stuff

    End Sub


    '
    '
    '
    Private Sub cancelAsyncPing()
        myPing.SendAsyncCancel()
    End Sub

#End Region

#Region " Send Sync "

    '
    '
    '
    Public Sub testSendSync()

        ' test gathering an IP address
        'Dim alAddrList As New ArrayList
        'Dim ipAddr As IPAddress
        'Dim value As String = "www.yahoo.com"
        'alAddrList = GetIPAddressFromName(value)
        'If alAddrList.Count > 0 Then
        ' ipAddr = alAddrList(0)
        ' props.sendaddress = ipAddr.ToString
        ' Else
        ' Dim strNoAddrResp As String = "no ip address returned for " & vbCrLf & value
        ' MsgBox(strNoAddrResp)
        ' Exit Sub
        ' End If

        ' test www.comcast.net
        props.sendaddress = "96.17.77.131"
        props.ttl = 32  ' good news, sometimes fails with ttl expired when set to 16
        props.fragment = True ' can use this for testing for black holes....
        props.sendtext = "abc"
        props.timeout = 100
        props.ReverseLookup = True

        sendsync()

        showstats()

    End Sub

    '
    '
    '
    Public Sub showstats()

        Dim sbResp As New StringBuilder
        sbResp.Append("Send Addr  : " & props.sendaddress & vbCrLf)
        sbResp.Append("Rcv IP Addr: " & props.rcvaddress & vbCrLf)
        sbResp.Append("Rcv Host   : " & props.rcvhost & vbCrLf)
        sbResp.Append("Status     : " & props.status & vbCrLf)
        sbResp.Append("Send Text  : " & props.sendtext & vbCrLf)
        sbResp.Append("RcvText    : " & props.rcvtext & vbCrLf)
        sbResp.Append("RT_Time    : " & props.rt_time.ToString & "(ms)" & vbCrLf)

        MsgBox(sbResp.ToString)

    End Sub

    '
    '
    '
    Public Sub sendsync()

        ' init the fields for what comes back so no nulls
        props.rcvaddress = ""
        props.rcvsize = 0
        props.rcvtext = ""
        props.rt_time = -1
        props.rcvhost = ""

        ' change the send text to a buffer
        Dim buffer As Byte() = {}
        buffer = Encoding.ASCII.GetBytes(props.sendtext)

        ' set the options
        Dim myOptions As PingOptions = New PingOptions
        myOptions.Ttl = props.ttl
        myOptions.DontFragment = props.fragment

        ' execute the ping and save the status
        Dim myReply As PingReply = Nothing

        myReply = myPing.Send( _
                props.sendaddress, _
                props.timeout, _
                buffer, _
                myOptions)

        props.status = myReply.Status.ToString

            Select Case myReply.Status

                Case IPStatus.Success
                    props.rcvaddress = myReply.Address.ToString
                    props.rcvsize = myReply.Buffer.Length
                    props.rcvtext = Encoding.ASCII.GetString(myReply.Buffer)
                    props.rt_time = myReply.RoundtripTime
                    If props.ReverseLookup = True Then
                        props.rcvhost = GetHostNameFromIP(myReply.Address.ToString)
                    End If
                Exit Select
                Case IPStatus.TtlExpired
                    ' ttl correctly responds with the address of who is
                    ' identifying that the ttl ran out so we save the address
                    props.rcvaddress = myReply.Address.ToString
                    If myReply.RoundtripTime <> 0 Then
                        props.rt_time = myReply.RoundtripTime
                    End If
                    If props.ReverseLookup = True Then
                        props.rcvhost = GetHostNameFromIP(myReply.Address.ToString)
                    End If
            End Select

    End Sub

#End Region

#Region " resolve names and addresses "

    '
    '
    '
    Public Function GetIPAddressFromName(ByVal strHostName As String) As ArrayList

        Dim ip_addresses() As IPAddress
        Dim alAddresses As New ArrayList
        Dim intX As Integer
        Dim ipTemp As IPAddress
        Dim strTemp As String
        Dim sbArray As New StringBuilder
        Try

            Forms.Cursor.Current = Forms.Cursors.WaitCursor
            ip_addresses = Dns.GetHostAddresses(strHostName)
            For intX = 0 To UBound(ip_addresses)
                ipTemp = ip_addresses(intX)
                alAddresses.Add(ipTemp)
                strTemp = ip_addresses(intX).ToString
                sbArray.Append(strTemp & " " & vbCrLf)
            Next
            Forms.Cursor.Current = Forms.Cursors.Default
            Return alAddresses


        Catch net As Net.Sockets.SocketException
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(net, "Network Policy")
            If (rethrow) Then
                Throw
            End If
        Catch err As Exception
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(err, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        End Try

        Return alAddresses


    End Function

    '
    '
    '
    Private Function GetHostNameFromIP(ByVal strIPAddr As String) As String

        Try

            Dim hostInfo As IPHostEntry
            hostInfo = Dns.GetHostEntry(strIPAddr)

            Return hostInfo.HostName.ToString

        Catch com As Net.Sockets.SocketException
            Return "GetNameError"
        Catch err As Exception
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(err, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
            Return ""
        End Try

    End Function

#End Region

#Region " IP Addressing routines "

    ' Inputs:local_ip, subnetmask, and remote_ip to be compared
    '
    ' Returns:returns true if remote address
    '     belongs to the same network, false other
    '     wise.
    '
    Public Function funcCompareIP _
                (ByVal ip1 As String, _
                ByVal subnetmask As String, _
                ByVal ip2 As String) _
                As Boolean

        Dim home_network(4) As String
        Dim remote_network(4) As String
        Dim mask(4) As String
        Dim allowed As Boolean
        Dim x As Integer


        mask(0) = convert_to_binary(Split(subnetmask, ".", -1, CompareMethod.Binary)(0))
        mask(1) = convert_to_binary(Split(subnetmask, ".", -1, CompareMethod.Binary)(1))
        mask(2) = convert_to_binary(Split(subnetmask, ".", -1, CompareMethod.Binary)(2))
        mask(3) = convert_to_binary(Split(subnetmask, ".", -1, CompareMethod.Binary)(3))

        home_network(0) = convert_to_decimal(logical_and(convert_to_binary(Split(ip1, ".", -1, CompareMethod.Binary)(0)), mask(0)))
        home_network(1) = convert_to_decimal(logical_and(convert_to_binary(Split(ip1, ".", -1, CompareMethod.Binary)(1)), mask(1)))
        home_network(2) = convert_to_decimal(logical_and(convert_to_binary(Split(ip1, ".", -1, CompareMethod.Binary)(2)), mask(2)))
        home_network(3) = convert_to_decimal(logical_and(convert_to_binary(Split(ip1, ".", -1, CompareMethod.Binary)(3)), mask(3)))

        remote_network(0) = convert_to_decimal(logical_and(convert_to_binary(Split(ip2, ".", -1, CompareMethod.Binary)(0)), mask(0)))
        remote_network(1) = convert_to_decimal(logical_and(convert_to_binary(Split(ip2, ".", -1, CompareMethod.Binary)(1)), mask(1)))
        remote_network(2) = convert_to_decimal(logical_and(convert_to_binary(Split(ip2, ".", -1, CompareMethod.Binary)(2)), mask(2)))
        remote_network(3) = convert_to_decimal(logical_and(convert_to_binary(Split(ip2, ".", -1, CompareMethod.Binary)(3)), mask(3)))

        allowed = False

        For x = 0 To 3
            If home_network(x) <> remote_network(x) Then
                allowed = False
                Exit For
            Else
                allowed = True
            End If
        Next
        funcCompareIP = allowed
    End Function

    '
    '
    '
    Private Function convert_to_binary _
            (ByVal str As String) _
            As String

        Dim i As Int32
        Dim x As Int32
        Dim Bin As String = ""

        x = CInt(str)

        For i = 7 To 0 Step -1
            If x And CInt(2 ^ i) Then
                Bin = Bin & "1"
            Else
                Bin = Bin & "0"
            End If
        Next

        convert_to_binary = Bin
    End Function

    '
    '
    '
    Private Function convert_to_decimal _
            (ByVal BinaryValue As String) _
            As String

        Dim Bit As Integer
        Dim Value As Integer
        Dim counter As Integer

        For counter = Len(BinaryValue) To 1 Step -1
            Bit = Mid(BinaryValue, counter, 1)
            If Bit = 1 Then
                Value = Value + 2 ^ (Len(BinaryValue) - counter)
            End If
        Next
        convert_to_decimal = CStr(Value)
    End Function

    '
    '
    '
    Private Function logical_and _
            (ByVal str1 As String, _
             ByVal str2 As String) _
             As String

        Dim result As String = ""
        Dim counter As Integer

        For counter = 1 To Len(str1)
            result = result & (Mid(str1, counter, 1) And Mid(str2, counter, 1))
        Next
        logical_and = result
    End Function

    '
    '
    '
    Private Function Base64Decode _
            (ByVal base64String As String) _
            As Object

        Const Base64CodeBase = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
        Dim dataLength As Int32
        Dim Out As String
        Dim groupBegin As Int32

        dataLength = Len(base64String)
        Out = ""

        If dataLength Mod 4 <> 0 Then
            Err.Raise(1, "Base64Decode", "Bad Base64 string.")
            Return ""
        End If

        For groupBegin = 1 To dataLength Step 4

            Dim numDataBytes As Integer
            Dim CharCounter As Integer
            Dim thisChar As String
            Dim thisData As String
            Dim groupData As String

            numDataBytes = 3
            groupData = 0

            For CharCounter = 0 To 3
                thisChar = Mid(base64String, groupBegin + CharCounter, 1)
                If thisChar = "=" Then
                    numDataBytes = numDataBytes - 1
                    thisData = 0
                Else
                    thisData = InStr(Base64CodeBase, thisChar) - 1
                End If
                If thisData = -1 Then
                    Err.Raise(2, "Base64Decode", "Bad character In Base64 string.")
                    Return ""
                End If
                groupData = 64 * groupData + thisData
            Next

            Dim OneChar As String = ""

            For CharCounter = 1 To numDataBytes
                Select Case CharCounter
                    Case 1 : OneChar = groupData \ 65536
                    Case 2 : OneChar = (groupData And 65535) \ 256
                    Case 3 : OneChar = (groupData And 255)
                End Select
                Out = Out & Chr(OneChar)
            Next
        Next

        Base64Decode = Out

    End Function

#End Region



End Class
